Pascal Super Library/Pascal Super Library (CW International)(1997).bin/PGM_TOOL/TCUNIT/TCUNIT.PAS

Pascal/Delphi Source File | 1989-07-02 | 6KB | 214 lines

(*
 *    PROGRAM : TCUnit--typed-constant editor
 *    SYSTEM  : Turbo Pascal 4.0, 5.0, and 5.5
 *    AUTHOR  : (C) 1988, 1989 by Tom Swan
 *)

UNIT TCUnit;


INTERFACE


PROCEDURE GetWord( prompt : String; VAR v : Word;
   low, high : Word );

PROCEDURE GetStr( prompt : String; VAR s : String;
   maxLen : Word );

FUNCTION ChangesSaved( fileName, searchStr : String;
   cbase, ebase : Word ) : Boolean;


IMPLEMENTATION

USES  Crt;     { Standard Borland display unit }

TYPE  ExeFile = File OF Char;    { Reads EXE files as file of char }


PROCEDURE GetWord( prompt : String; VAR v : Word; low, high : Word );

{ Prompt for word value, displaying prompt string and limiting
response in v to the range low..high. }

VAR   response : String[8];      { Holds response to prompt }
      newValue : Word;           { Possible new value for v }
      e : Integer;               { Error code for Val() }

BEGIN
   ClrScr;
   Writeln;
   Writeln( prompt, ' = ', v );
   Writeln;
   Writeln( 'Enter new value from ', low, ' to ', high );
   Write(   'or press Enter for no change: ' );
   Readln( response );
   IF Length( response ) > 0 THEN
   BEGIN
      Val( response, newValue, e );
      IF ( e = 0 ) AND ( low <= newValue ) AND ( newValue <= high )
       THEN
         v := newValue
       ELSE
         BEGIN
            Writeln;
            Write( 'Entry error.  Press Enter...' );
            Readln
         END { else }
   END { if }
END; { GetWord }


PROCEDURE GetStr( prompt : String; VAR s : String; maxLen : Word );

{ Prompt for string, displaying prompt string and limiting response
in s to string length 0..maxLen. }

VAR   response : String;      { Holds response to prompt }

BEGIN
   ClrScr;
   Writeln;
   Writeln( prompt, ' = ', s );
   Writeln;
   Writeln( 'Enter new string with up to ', maxLen, ' characters' );
   Write(   'or press Enter for no change: ' );
   Readln( response );
   IF Length( response ) > 0 THEN
   BEGIN
      IF Length( response ) <= maxLen
       THEN
         s := response
       ELSE
         BEGIN
            Writeln;
            Write( 'Entry error.  Press Enter...' );
            Readln
         END { else }
   END { if }
END; { GetStr }


PROCEDURE ShowError( e : Integer );

{ Display an error message.  e>0 = I/O error; e<0 = other error }

BEGIN
   IF e > 0
      THEN Writeln( 'I/O Error #', e )
      ELSE Writeln( 'Error in EXE file format' );
   Writeln;
   Writeln( 'WARNING: EXE file may be damaged!' );
   Writeln;
   Write( 'Press Enter...' );
   Readln
END; { ShowError }


{$i-}    { Shut off I/O error checks }


FUNCTION FoundCBase( VAR f : ExeFile; VAR searchStr : String;
   VAR offset : LongInt ) : Boolean;

{ Return True if searchString (CBase) is found in file f.  If found,
then return byte offset to string in file. }

VAR   position : LongInt;        { Possible position of match }
      ch : Char;                 { Holds candidate bytes from file }

   FUNCTION FoundMatch : Boolean;
   { True if current position = search string }
   VAR   i : Integer;   { searchStr index }
   BEGIN
      FOR i := 2 TO Length( searchStr ) DO
      BEGIN
         Read( f, ch );
         IF ch <> searchStr[i] THEN
         BEGIN
            FoundMatch := False;
            Exit
         END { if }
      END; { for }
      FoundMatch := True
   END; { FoundMatch }

BEGIN
   Reset( f );             { Start search at beginning of file }
   WHILE NOT Eof( f ) DO
   BEGIN
      Read( f, ch );
      IF ch = searchStr[1] THEN        { Test one char }
      BEGIN
         position := FilePos( f );     { Remember position }
         IF FoundMatch THEN            { Check for match }
         BEGIN
            offset := position - 2;    { Found: return offset }
            (* Writeln; Writeln( 'Offset = ', offset ); *)
            FoundCBase := True;        { Set function result }
            Exit                       { Stop searching }
         END ELSE
            Seek( f, position )        { Continue search }
      END { if }
   END; { while }
   FoundCBase := False     { searchStr isn't there }
END; { FoundCBase }


PROCEDURE SaveData( VAR f : ExeFile; offset, cbase, len : LongInt;
  VAR e : Integer );

{ Write len bytes to file f, beginning at byte #offset in the file
and transferring from memory len bytes starting at DS:cbase.  Return
any errors in e.  This copies the in-memory typed constants to the
EXE file image on disk. }

VAR   i : Word;      { Mem[] array index }

BEGIN
   Seek( f, offset );
   FOR i := 0 TO ( len - 1 ) DO
   BEGIN
      Write( f, Char( Mem[ DSeg:( cbase + i ) ] ) );
      e := IoResult;
      IF e <> 0 THEN Exit
   END { for }
END; { SaveData }


FUNCTION ChangesSaved( fileName, searchStr : String; cbase,
   ebase : Word ) : Boolean;

{ Return True if typed constants in memory are written to disk.
fileName must be a Turbo Pascal compiled EXE file.  searchStr
should equal the CBase marker string at the start of the typed
constants area.  cbase should be the in-memory offset to the CBase
typed constant.  ebase should be the in-memory offset to the EBase
typed constant. }

VAR   f : ExeFile;         { Read .EXE as a char file }
      offset : LongInt;    { Byte offset to CBase in .EXE file }
      err : Integer;       { Error code }

BEGIN
   GotoXY( 1, 25 );
   ClrEol;
   Write( 'Saving changes to ', fileName, '. Please wait...' );
   Assign( f, fileName );
   Reset( f );
   err := IoResult;
   IF err = 0 THEN
      IF FoundCBase( f, searchStr, offset )
         THEN SaveData( f, offset, cbase, ( ebase - cbase ), err );
   ChangesSaved := ( err = 0 );  { i.e. True if no error }
   Writeln;
   IF err = 0
      THEN Writeln( 'Changes saved' )
      ELSE ShowError( err );
   Close( f )
END; { ChangesSaved }


END. { TCUnit }